Otherware/Otherware_1_SB_Development.iso/mac/hypercar/xfcn/spttool.cpt/Support Tools eXternals 1.2.5/card_35218.txt

Text File | 1990-11-13 | 18KB | 452 lines

-- card: 35218 from stack: in.5
-- bmap block id: 10518
-- flags: 0000
-- background id: 3858
-- name: FolderContents
----- HyperTalk script -----
on CloseCard
  put empty into cd fld "folder list"
  set the scroll of cd fld "folder list" to 0
  pass CloseCard
end CloseCard

on HideObjects
  hide cd fld "folder list"
  hide cd btn "try it!"
end HideObjects

on ShowObjects
  show cd fld "folder list"
  show cd btn "try it!"
end ShowObjects


-- part 1 (button)
-- low flags: 00
-- high flags: A002
-- rect: left=82 top=292 right=326 bottom=175
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 8192
-- line height: 16
-- part name: Try It!
----- HyperTalk script -----
on mouseUp
  global errGlobal
  put FolderPath("Choose a folder to list.") into folderName
  if folderName = empty then exit mouseUp
  put FolderContents(folderName, "Both", "noDialog:errGlobal") into FolderInfo
  if errGlobal Γëá empty then
    answer "Error: ΓÇ£" & errGlobal & "ΓÇ¥"
    put empty into errGlobal
  else
    put FolderInfo into cd fld "folder list"
  end if
end mouseUp




-- part 2 (field)
-- low flags: 00
-- high flags: 0007
-- rect: left=19 top=117 right=288 bottom=236
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 4
-- text size: 9
-- style flags: 0
-- line height: 12
-- part name: folder list


-- part contents for background part 38
----- text -----
22/50

-- part contents for background part 20
----- text -----
FolderContents - An XFCN to return the files/folders contained in a specified folder.

FolderContents(Pathname, «,"Files"|"Folders"|"Both"» «"noDialog:"errorGlobal»)
PATHNAME : a path to a folder to examine
PARAMETER 2 should be the literal string      "Files", "Folders" or "Both".

This XFCN will return a carraige return delimited list (one file/folder per line) of all files, folders, or both files and folders (as per parameter 2) within the specified directory.  The names of all folders will end in a ":".  The default is to list "both" files and folders.  The next version will be A/UX compatible.


-- part contents for background part 42
----- text -----
{ FolderContents(pathname «,"Files"|"Folders"|"Both"» «,"nodialog":errGlobal»)     }
{ XFCN to return the file/folder names in the specified path given in the     }
{ first parameter.                                                                 }
{ Second parameter specifies what will be returned.  Only files, only         }
{ folders, or both files & folders can be returned in the list.                  }
{}
{   Written by:   Anup Murarka       Eric Carlson                  }
{               ALINK:  SKEPTIC       ALINK:  cyNic           }
{                                   CIS:  76004,3356}
{}
{               We are part of the Support Tools Development Group,    }
{               Apple Computer, Inc.     }
{}
{               please DO NOT contack Mac DTS for support of this code!   }
{}
{               please DO contact the authors for support of this code!  }
{}
{               Send comments, bug reports, requests to any of the above    }
{               E-mail addresses or to:}
{}
{                           (one of us)                    }
{                           Apple Computer, Inc.         }
{                           900 E. Hamilton, Ave.       }
{                           Campbell, CA   95008       }
{                           M/S 72-L                     }
{}
{   Copyright:    © 1989, 1990 by Apple Computer, Inc., all rights reserved.     }
{}
{ written by      : Anup Murarka                                                                                     }
{ AppleLink   : Skeptic                                                                                           }
{ modification history                                                                                           }
{          Date            Initials                                      Comments                                     }
{          ----            -----      -----------------------------------------------------}
{       8/16/89          akm      first written                                                                     }
{       5/21/90          ec             removed upper case converion for A/UX compatibility. }
{                                           Changed version to 1.1.  added error checking when adding }
{                                           to result handle, added code to disposhandle if we bail   }
{                                           because of an error.                                                          }
{       5/23/90          ec         assume user wants 'BOTH' if only one parameter passed}
{}
unit FolderContents;

interface

    uses
        HyperXCmd;

    procedure MAIN (paramPtr: XCmdPtr);

implementation

    procedure FolderContents (paramPtr: XCmdPtr);
    FORWARD;

    procedure MAIN (paramPtr: XCmdPtr);
    begin
        FolderContents(paramPtr);
    end;

    procedure reportToUser (paramPtr: XCmdPtr;
                                    msgStr: str255);
{}
{ report something back to the user.  }
{ the last parameter (optional) to an external may contain }
 { "noDialog" or "noDialog:GlobalName".  GlobalName is the name }
 { of a HyperTalk global variable into which error messages will be }
 { placed.  we've decided to use this approach to avoid confusing }
{ an error message with a valid result being returned from an XFCN. }
{}
        var
            tempStr: str255;
    begin
{check the last param to see if the user requested that}
{ we suppress the error dialog }
        ZeroToPas(paramPtr, paramPtr^.params[paramPtr^.paramCount]^, tempStr);
        UprString(tempStr, true);
        if pos('NODIALOG', tempStr) = 0 then
    { no special error handling specified, throw up a dialog and return the error message }
            begin
                SendCardMessage(paramPtr, concat('answer "', msgStr, '"'));
                paramPtr^.returnValue := PasToZero(paramPtr, msgStr);
            end
        else if (pos(':', tempStr) > 0) then
    { requested global AND noDialog so we fill in the global and return empty }
            begin
                tempStr := copy(tempStr, pos(':', tempStr) + 1, length(tempStr));
                                                        { get the name of the HC global  to fill }
                SetGlobal(paramPtr, tempStr, PasToZero(paramPtr, msgStr));
                                                        { and fill it }
                paramPtr^.returnValue := PasToZero(paramPtr, '');  { return empty }
            end
        else
    { requested noDialog only so we return the error condition as the result }
            paramPtr^.returnValue := PasToZero(paramPtr, msgStr);
    end;      { procedure }

    function AskedForHelp (paramPtr: XCmdPtr;
                                    syntaxMsg: Str255;
                                    copyrightMsg: Str255): boolean;
{   check to see if the user sent a '?' or a '!' as }
{ the only parameter. if so we will respond with }
{ the calling syntax or the copyright/version info }
{ for this external }
{}
        var
            firstStr: str255;
    begin
        askedForHelp := false;
        if paramPtr^.paramCount = 1 then
            begin
                ZeroToPas(paramPtr, paramPtr^.params[1]^, firstStr);
                    { what is the first param? }
                if firstStr = '?' then
                    begin
                        reportToUser(paramPtr, syntaxMsg);
                        askedForHelp := true
                    end   { asked for help }
                else if firstStr = '!' then
                    begin
                        reportToUser(paramPtr, copyRightMsg);
                        askedForHelp := true
                    end;      { asked for copyright info }
            end;      { one parameter passed }
    end;      { function }

    function LongToString (paramPtr: XCmdPtr;
                                    num: LONGINT): Str255;
{ why, oh why did dan write this one as a procedure??? }
        var
            tempStr: str255;
    begin
        LongToStr(paramPtr, num, tempStr);
        LongToString := tempStr;
    end;

    function NumberToString (paramPtr: XCmdPtr;
                                    num: LONGINT): Str255;
{ use the toolbox call rather than HC's }
        var
            tempStr: str255;
    begin
        NumToString(num, tempStr);
        NumberToString := tempStr;
    end;

    procedure reportResError (paramPtr: XCmdPtr;
                                    errorNum: integer);
        var
            errMsg, tempName: str255;
    begin
        case errorNum of                      { what caused the problem? }
            -0:
                errMsg := 'no error.';
            -36:
                errMsg := 'I/O Error.';
            -37:
                errMsg := 'bad file name or volume name.';
            -38:
                errMsg := 'file not open.';
            -39:
                errMsg := 'that file has no resource fork.';
            -42:
                errMsg := 'too many files open.';
            -43:
                errMsg := 'file not found.';
            -45, -54, -61:
                errMsg := 'file locked.';
            -47, -49:
                errMsg := 'file is busy.';
            -53:
                errMsg := 'that volume is not on line.';
            -108:
                errMsg := 'not enough room in heap zone.';
            -120:
                errMsg := 'directory not found.';
            -121:
                errMsg := 'too many working directories open.';
            -127:
                errMsg := 'internal file system error.';
            -192:
                errMsg := 'resource not found.';
            -193:
                errMsg := 'file not found.';
            otherwise
                errMsg := concat('unexpected error #', NumberToString(paramPtr, errorNum));
        end;          { case }

        errMsg := concat('Sorry, ', errMsg);
        reportToUser(paramPtr, errMsg);
        { return the error message }
    end;          { function }

    function getVolRefNum (pathName: str255): integer;
    { function to return the volume reference number of the volume specified in the pathName}
    { parameter.  Will automatically strip any trailing directory/file names}
        var
            paramBlock: HParamBlockRec;
            errorCode: OSerr;
    begin
        if pos(':', pathName) = 0 then
            pathName := concat(pathName, ':')
        else
            pathName := copy(pathName, 1, pos(':', pathName));
        with paramBlock do
            begin
                ioCompletion := nil;
                ioNamePtr := @pathName;
                ioVRefNum := 0;
                ioVolIndex := -1;
        { if volindex is zero the file manager will try to get to the volume}
        { through the ioVRefNum ΓÇö not a good thing here as that is what we don't know! }
            end;
        errorCode := PBHGetVInfo(@paramBlock, FALSE);
        if errorCode <> noErr then
            getVolRefNum := -1
        else
            getVolRefNum := paramBlock.ioVRefNum;
    end;

    function BitTest (AddressToCheck: ptr;
                                    TotalBits: integer;
                                    BitToTest: longint): boolean;
    { function that allows caller to use std. 68000 bit notation instead of the Toolbox's reversed notation}
    { example:  bit 0 (the least significant bit) in a byte is bit 7 in the Toolbox's notation}
    begin
        BitTest := BitTst(AddressToCheck, TotalBits - 1 - BitToTest);
    end;

    function AppendString (h: Handle;
                                    newStr: Str255): OSErr;
    { stick the string onto the back of the handle }
    begin
        AppendString := PtrAndHand(Ptr(ORD4(@newStr) + 1), h, LENGTH(newStr));
    end;

    function getParams (paramPtr: XCmdPtr;
                                    var PathToSearch: str255;
                                    var LookForFiles, LookForFolders: boolean): boolean;
    { function to get the parameters and validate them.  Returns boolean instructing}
    { the main procedure to continue if the parameters passed are valid.  Also returns}
    { syntax messages if asked for by the user.}
        var
            WhatToLookFor: str255;
            numParams: integer;
            inputCh: str255;
            syntaxStr, copyrightStr: str255;

    begin
        getParams := true;               {Initially, assume the parameters are valid.}
        syntaxStr := 'FolderContents(pathname «,“Files”|“Folders”|“Both”» «,“nodialog”:errGlobal»)';
        copyrightStr := '© 1989,1990 Apple Computer, Inc., v.1.1, by Anup Murarka';

        { Check for syntax or copyright requests}
        if AskedForHelp(paramPtr, syntaxStr, copyrightStr) then
            begin
                getParams := false;
                exit(getParams);
            end;

        { Check parameter count}
        numParams := paramPtr^.paramCount;
        if (numParams < 1) or (numParams > 3) then {check that we have the proper number of parameters}
            begin
                getParams := false;
                reportToUser(paramPtr, syntaxStr);
                exit(getParams);
            end;

    { Get parameter 1, where to look }
        ZeroToPas(paramPtr, paramPtr^.Params[1]^, PathToSearch);

        if numParams = 1 then              { default is to look for both }
            whatToLookFor := 'BOTH'
        else
            begin
    { Get parameter 2, what to look for }
                ZeroToPas(paramPtr, paramPtr^.Params[2]^, whatToLookFor);
                UprString(whatToLookFor, true);          { convert to uppercase }

                if (whatToLookFor <> 'FILES') and (whatToLookFor <> 'FOLDERS') and (whatToLookFor <> 'BOTH') then
                    begin
                        getParams := false;
                        reportToUser(paramPtr, syntaxStr);
                    end;
            end;

        LookForFolders := true;            {assume that everything should be returned}
        LookForFiles := true;
        if (whatToLookFor = 'FILES') then
            LookForFolders := False
        else if (whatToLookFor = 'FOLDERS') then
            LookForFiles := False;
    end;          {GetParams}

    procedure FolderContents (paramPtr: XCmdPtr);
        var
            filelist: handle;
            getParamsOK, ItIsAFolder, LookForFiles, LookForFolders: boolean;
            FileName: str255;
            paramBlock: CInfoPBRec;
            errorCode: OSerr;
            dirIndex: integer;
            DirToScan: longint;

    begin    { FolderContents}
    { fetch and validate the passed parameters}
        getParamsOK := getParams(paramPtr, fileName, lookForFiles, lookForFolders);
        if not (getParamsOK) then
            exit(FolderContents);

    { Initialize the parameter block.  Since we have the full pathname, no other field is really needed, but}
    { future use of the paramBlock will need the vRefNum since PathToSearch won't always contain the}
    { full pathname.}
        zeroBytes(paramPtr, @paramBlock, sizeOf(paramBlock));
        paramBlock.ioNamePtr := @fileName;
        paramBlock.ioVRefNum := getVolRefNum(fileName);

        errorCode := PBGetCatInfo(@paramBlock, FALSE);
        if errorCode <> noErr then
            begin
                reportToUser(paramPtr, 'Sorry, directory not found.');
                exit(FolderContents);
            end;
        if not bitTest(@paramBlock.ioFlAttrib, 8, 4) then
            begin
                reportToUser(paramPtr, 'Sorry, I handle FOLDER contents, not file contents!');
                exit(FolderContents);
            end;

    { Initialize the handle that will contain the directory listing}
        filelist := NewHandle(0);

        dirIndex := 1;
        DirToScan := paramBlock.ioDrDirID;
        repeat      {repeat until all files/folders within dirIDToScan are noted}
            FileName := '';      { zero the name so that it is not used to find the next file}
            paramBlock.ioFDirIndex := dirIndex;          { ioFDirIndex is incremented to point to the next file/folder}
            paramBlock.ioDrDirID := DirToScan;          { this has to be reset each iteration}
            errorCode := PBGetCatInfo(@paramBlock, FALSE);        { get the file/folder info}
            if errorCode = noErr then          { if something was found: }
                begin
                    ItIsAFolder := bitTest(@paramBlock.ioFlAttrib, 8, 4);
                    if ItIsAFolder then
                        FileName := concat(FileName, ':');
                    if (ItIsAFolder and LookForFolders) or ((not ItIsAFolder) and LookForFiles) then
                        errorCode := appendString(filelist, concat(FileName, chr(13)));        {add to the list}
                    if errorCode <> noErr then
                        begin
                            reportToUser(paramPtr, 'Sorry, could not build list.');
                            if fileList <> nil then
                                DisposHandle(fileList);
                            exit(FolderContents);
                        end;
                end;
            dirIndex := dirIndex + 1;
        until errorCode <> noErr;

    { Now append a null character onto the end of the result}
        errorCode := appendString(filelist, chr(0));
        if errorCode <> noErr then
            begin
                reportToUser(paramPtr, 'Sorry, could not build list.');
                if fileList <> nil then
                    DisposHandle(fileList);
                exit(FolderContents);
            end;
        paramPtr^.returnValue := filelist;
    end;
end.